home *** CD-ROM | disk | FTP | other *** search
/ MacHack 1997 / MacHack 1997.toast / Presentations / Presentations ’93 / Voice Toolkit / Voice Handler < prev    next >
Encoding:
Text File  |  1993-05-03  |  8.0 KB  |  258 lines  |  [TEXT/CCL2]
  1.  
  2. ;modified 11/10/92 - changing to packages
  3. ;modified 11/25/92 - code cleanup, move flag display to its own file
  4.  
  5. (in-package "VOICE-TOOLKIT")
  6. (export '(set-voice-handler close-voice-handler))
  7.  
  8. ;************************************************************************************
  9.  
  10. ;data structures used by Voice Handler
  11.  
  12. (defparameter *voice-system* nil
  13.   "is set to t the first time speech input arrives for processing")
  14.  
  15. (defparameter *attention* nil
  16.   "boolean for whether Cookie is alerted for voice input")
  17.  
  18. (defparameter *screen* nil "currently focused voice window")
  19.  
  20. (defparameter *wordtable* (make-hash-table :test #'equal)
  21.   "Each word keyed to list of items whose labels contain the word")
  22.  
  23. (defparameter *wordlist* nil 
  24.   "list of words heard since *attention* became true")
  25.  
  26. (defparameter *marked* nil
  27.   "list of the currently marked items")
  28.  
  29. (defparameter *fixes* nil "list of possible fixes")
  30.  
  31. (defparameter *mark-method* :ITALIC 
  32.   "method used to indicate possible items on screen")
  33.  
  34. (defparameter *start-word* "LISTEN"
  35.   "word which alerts handler for further input")
  36.  
  37. (defparameter *fire-word* "GO"
  38.   "word which tells handler to simulate mouse click on indicated item")
  39.  
  40. (defparameter *cancel-word* "FORGET IT"
  41.   "word which tells handler to cancel input and become unalert")
  42.  
  43. (defparameter *next-guess* "NEXT"
  44.   "word which tells handler to indicate next guess, if applicable")
  45.  
  46. (defparameter *guessing* nil
  47.   "boolean to set guessing functionality on or off")
  48.  
  49. ;*********************************************************************************
  50.  
  51. ;exported functions
  52.  
  53. (defun set-voice-handler (&key (alert-on 'keep)
  54.                                cancel-on 
  55.                                (accept-on 'keep)
  56.                                next-guess-on
  57.                                (guessing-p *guessing*)
  58.                                mark-method)
  59.   "Allows user modifications to Voice Handler behavior"
  60.   (if (not (equal alert-on 'keep))
  61.     (if (or (not alert-on) (stringp alert-on))
  62.       (setf *start-word* (if (stringp alert-on) 
  63.                            (string-upcase alert-on)
  64.                            alert-on))
  65.       (error "~a is not a valid alert-on (must be a string)" alert-on)))
  66.   (if cancel-on
  67.     (if (stringp cancel-on)
  68.       (setf *cancel-word* (string-upcase cancel-on))
  69.       (error "~a is not a valid cancel-on (must be a string)" cancel-on)))
  70.   (if (not (equal accept-on 'keep))
  71.     (if (or (not accept-on) (stringp accept-on))
  72.       (if (and *guessing* (not accept-on))
  73.         (error "Must have a word for accept-on while guessing is enabled")
  74.         (setf *fire-word* (if (stringp accept-on) 
  75.                             (string-upcase accept-on)
  76.                             accept-on)))
  77.       (error "~a is not a valid accept-on (must be a string)" accept-on)))
  78.   (if next-guess-on
  79.     (if (stringp next-guess-on)
  80.       (setf *next-guess* (string-upcase next-guess-on))
  81.       (error "~a is not a valid next-guess-on (must be a string)"
  82.              next-guess-on)))
  83.   (if (and guessing-p (not *guessing*))
  84.     (if *fire-word*
  85.       (progn 
  86.         (setf *guessing* guessing-p)
  87.         (load-twins))
  88.       (error "A word must first be provided for accept-on so that a guess may be validated")))
  89.   (if (and (not guessing-p) *guessing*)
  90.     (progn
  91.       (setf *guessing* guessing-p)
  92.       (file-twins (report-twins))))
  93.   (if mark-method
  94.     (if (valid mark-method)
  95.       (setf *mark-method* (valid mark-method))
  96.       (error "Mark-method must be ITALIC, BOLD or a color value")))
  97.   (if (and *screen* (not *start-word*) (not *attention*)) (pay-attention))) 
  98.  
  99. (defun close-voice-handler ()
  100.   "shuts down voice handler"
  101.   (hide-flag)
  102.   (if *guessing* (file-twins (report-twins))))
  103.  
  104. ;*********************************************************************************
  105.  
  106. ;functions used for interface between Voice Handler and voice objects
  107.  
  108.  
  109. (defun new-voice-window (vw)
  110.   (cond ((not (eq *screen* vw))
  111.          (remove-voice-window *screen*)
  112.          (setf *screen* vw)
  113.          (identify vw)
  114.          (and *voice-system* 
  115.               (show-flag))
  116.          (if (null *start-word*) (pay-attention)))
  117.         (t nil)))
  118.  
  119.  
  120. (defun remove-voice-window (vw)
  121.   (if (eq *screen* vw) 
  122.     (progn (clrhash *wordtable*)
  123.            (reset-voice)
  124.            (setf *screen* nil)
  125.            (hide-flag))))
  126.  
  127.  
  128. (defun onscreen-p (item)
  129.   (equal (view-container item) *screen*))
  130.  
  131.  
  132. (defun reset-voice ()
  133.   (if *attention* (drop-attention)))
  134.  
  135.  
  136. (defun file-voice-item (item)
  137.   "puts new item into hash table"
  138.   (mapcar #'(lambda (word)
  139.               (setf (gethash word *wordtable*)
  140.                     (union (find-items (list word)) (list item))))
  141.           (string-to-wordlist (string-upcase (text item)))))
  142.  
  143.  
  144. (defun file-voice-items (itemlist)
  145.   (mapcar #'file-voice-item itemlist))
  146.  
  147.  
  148. (defun remove-voice-item (item)
  149.   "removes item from hash table and item list"
  150.   (reset-voice)
  151.   (mapcar #'(lambda (word)
  152.               (setf (gethash (string-upcase word) *wordtable*)
  153.                     (set-diff (gethash (string-upcase word) *wordtable*)
  154.                               (list item))))
  155.           (string-to-wordlist (text item))))
  156.  
  157.  
  158. (defun remove-voice-items (itemlist)
  159.   (mapcar #'remove-voice-item itemlist))
  160.  
  161.  
  162. ;*************************************************************************************
  163.  
  164. ;Voice Navigator handler code
  165.  
  166. (defun hear (word)
  167.   "this is the function directly called by the Voice Navigator via appleevent"
  168.   (if *attention*
  169.     (cond ((equal word *fire-word*)
  170.            (if (successful)
  171.              (drop-attention)))
  172.           ((equal word *cancel-word*)
  173.            (drop-attention))
  174.           ((and *fixes* (equal word *next-guess*))
  175.            (if (null (rest *fixes*))
  176.              (progn
  177.                (setf *fixes* nil)
  178.                (mark-items nil)
  179.                (frown))
  180.              (progn
  181.                (setf *fixes* (rest *fixes*))
  182.                (mark-items (list (fix-item))))))
  183.           (t (setf *wordlist* (cons word *wordlist*))
  184.              (setf *fixes* nil)
  185.              (mark-items (find-items *wordlist*))
  186.              (cond ((and *marked* (null (rest *marked*)))
  187.                     (if (and *fire-word* (careful (first *marked*)))
  188.                       (smile)
  189.                       (hear *fire-word*)))
  190.                    (*marked* (question))
  191.                    ((and (null *marked*) *guessing* (guess-fixes))
  192.                     (mark-items (list (fix-item)))
  193.                     (question-guess))
  194.                    (t (frown)))))
  195.     (if (equal word *start-word*) (pay-attention)))
  196.   (values))
  197.  
  198.  
  199. (defun pay-attention ()
  200.   (setf *attention* t)
  201.   (and *voice-system* (question)))
  202.  
  203.  
  204. (defun drop-attention ()
  205.   (if *start-word*
  206.     (progn
  207.       (setf *attention* nil)
  208.       (and *voice-system* (blank-flag)))
  209.     (and *voice-system* (question)))
  210.   (setf *wordlist* nil)
  211.   (setf *fixes* nil)
  212.   (mark-items nil))
  213.  
  214.  
  215. (defun successful ()
  216.   "if possible items narrowed to one, select that one"
  217.   (if (and *marked* (null (rest *marked*)))
  218.     (progn
  219.       (if *fixes* (record-fix))
  220.       (activate (first *marked*))
  221.       t)))
  222.  
  223.  
  224. (defun activate (item)
  225.   "necessary to be sure that the AppleEvent handler returns so that
  226.    further event processing can take place"
  227.   (setf *eventhook*
  228.         (cons #'(lambda ()
  229.                   (setf *eventhook*
  230.                         (rest *eventhook*))
  231.                   (select item)
  232.                   nil)
  233.               (if (listp *eventhook*) *eventhook* (list *eventhook*)))))
  234.  
  235.  
  236. (defun find-items (words)
  237.   (if (null (rest words))
  238.     (gethash (first words) *wordtable*)
  239.     (if (and *marked* (null *fixes*))
  240.       (intersection *marked* 
  241.                     (gethash (first words) *wordtable*)))))
  242.  
  243.  
  244. (defun mark-items (items)
  245.   (mapcar #'mark (set-diff items *marked*))
  246.   (mapcar #'unmark (set-diff *marked* items))
  247.   (setf *marked* items))
  248.  
  249.  
  250. (defmethod voice-handler ((a application) theAppleEvent reply handlerRefcon)
  251.   (if *screen* (voice-handler *screen* theAppleEvent reply handlerRefcon)))
  252.  
  253.  
  254. (install-appleevent-handler :|aevt| :|hear| #'voice-handler)
  255.  
  256.  
  257. ;**********************************************************************************
  258.